home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The CICA Windows Explosion!
/
The CICA Windows Explosion! - Disc 2.iso
/
programr
/
wpjv1n2.zip
/
D&DSERV.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-31
|
5KB
|
196 lines
(*****************************************)
(* *)
(* D&D-Server (d&dserv.pas) *)
(* *)
(* A simple app to demonstrate the *)
(* programming of a Drag&Drop-server *)
(* *)
(* Copyright (c) 1992,93 by A. Furrer *)
(* *)
(* This program requires Windows 3.1 *)
(*****************************************)
program DDServ;
uses Strings, WinTypes, WinProcs, WObjects;
const ws_Ex_AcceptFiles = $00000010;
wm_DropFiles = $0233;
(* These files we want to drop to a D&D-Client *)
const s : array[1..3,0..255] of char=('C:\autoexec.bat',
'C:\config.sys',
'C:\dos\command.com');
(****************************************************)
(* DragDropStruct *)
(* *)
(* This is the Drag&Drop structure used by Windows. *)
(* The format is NOT documented so it can change *)
(* in the next release of Wndows. *)
(****************************************************)
type PDragDropStruct =^TDragDropStruct;
TDragDropStruct = record
DataOffset : word;
DropPoint : TPoint;
DropInNonClient : bool;
Data : array[0..0] of char;
end;
(****************)
(* Mainwindow *)
(****************)
type
PMainwindow = ^TMainwindow;
TMainwindow =object(TWindow)
Drag : boolean;
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure WMLButtonDown(var Msg : TMessage); virtual wm_first +
wm_LButtonDown;
procedure WMMouseMove(var Msg : TMessage); virtual wm_first + wm_MouseMove;
procedure WMLButtonUp(var Msg : TMessage); virtual wm_first + wm_LButtonUp;
end;
constructor TMainwindow.Init;
begin
TWindow.Init(AParent,ATitle);
Drag:=false;
end;
procedure TMainwindow.WMLButtonDown;
begin
(* Now be begin to Drag&Drop *)
(* and we have to capture the mouse *)
Drag:=true;
SetCapture(HWindow);
end;
procedure TMainwindow.WMMouseMove;
var DragWnd : HWnd;
Point : TPoint;
begin
(* if we do Drag&Drop *)
if Drag then begin
(* get the window under the cursor *)
Point.X:=LoWord(GetMessagePos);
Point.Y:=HiWord(GetMessagePos);
DragWnd:=WindowFromPoint(Point);
(* and test if it accepts dropped files *)
if GetWindowLong(DragWnd,gwl_ExStyle) and
ws_Ex_AcceptFiles=ws_Ex_AcceptFiles then
(* set the cursor to a cross *)
SetCursor(LoadCursor(0,idc_Cross))
else
(* set the default cursor *)
SetCursor(LoadCursor(0,idc_Arrow))
end;
end;
procedure TMainwindow.WMLButtonUp;
var DropWnd : HWnd;
Point : TPoint;
DataHandle : THandle;
DataPtr,p : PChar;
l : longint;
i : word;
begin
(* if we do Drag&Drop *)
if Drag then begin
(* get the window under the cursor *)
Point.X:=LoWord(GetMessagePos);
Point.Y:=HiWord(GetMessagePos);
DropWnd:=WindowFromPoint(Point);
(* and test if it accepts dropped files *)
if GetWindowLong(DropWnd,gwl_ExStyle) and
ws_Ex_AcceptFiles=ws_Ex_AcceptFiles then begin
(* Count the length of the data *)
l:=0;
for i:=1 TO 3 do
l:=l+StrLen(s[i])+1;
(* and allocate memory *)
DataHandle:=GlobalAlloc(gmem_DDEShare,sizeof(TDragDropStruct)+l);
(* To set the data we have to *)
(* lock the memory *)
DataPtr:=GlobalLock(DataHandle);
(* fill in the Drag&Drop structur *)
with PDragDropStruct(DataPtr)^ do begin
DataOffset:=Data-DataPtr;
DropInNonClient:=(DefWindowProc(DropWnd,wm_NCHitTest,0,longint(Point))<>htClien
t);
ScreenToClient(DropWnd,Point);
DropPoint :=Point;
end;
(* now we set the data *)
p:=PDragDropStruct(DataPtr)^.Data;
for i:=1 to 3 do begin
StrCopy(p,s[i]);
p:=p+StrLen(s[i])+1;
end;
(* mark the end of the data *)
p^:=#0;
(* and unlock the memory *)
GlobalUnlock(DataHandle);
(* post the wm_DropFiles message *)
(* to the window under the cursor *)
PostMessage(DropWnd,wm_DropFiles,DataHandle,0);
(* set the default cursor and *)
(* release the capture *)
SetCursor(LoadCursor(0,idc_Arrow));
ReleaseCapture;
Drag:=false;
end;
END;
end;
(**********************)
(* TDDServApplication *)
(**********************)
type
TDDServApplication =
object(TApplication)
procedure InitMainWindow; virtual;
end;
procedure TDDServApplication.InitMainWindow;
begin
MainWindow := New(PMainwindow,Init(nil, 'D&DServer'));
end;
(***************)
(* Mainprogram *)
(***************)
var
Prg : TDDServApplication;
begin
Prg.Init('D&DServer');
Prg.Run;
Prg.Done;
end.